perm filename ROTB.SAI[1,JMC] blob sn#005246 filedate 1970-01-04 generic text, type T, neo UTF8
00100	begin integer m,n,p,q,i,j,brk; real c,dc,x,y,z,w,dx,cmin,cmax,
00200	dc0,xmin,xmax; label a,b,aa,bb,cc;
00300	external real procedure realscan(reference string x;reference integer xx);
00400	string temp_shit;
00500	real procedure r(real u,lam);begin return(
00600	lam+u*(2-u)
00700	) end;
00710	real procedure sqrt(real x); begin real y; integer i;
00720	y←0.5*(x+1.0);
00730	for i←1 step 1 until 4 do
00740	y←0.5*(1.0+x/y) end;
00800	aa:
00900	outstr("
01000	
01100	p="); p←cvd(inchwl); outstr("q="); q←cvd(inchwl);
01200	
01300	c←0; dc←p/q;
01400	
01500	b:
01600	c←c+dc;x←0.0;
01700	
01800	y←x;m←0;
01900	for i←1 step 1 until q do begin
02000	m←m+(j←z←c+sqrt(y));y←z-j end;
02100	if m > 0 then begin if y<x then m←m-1 end
02200	else if m<0 then begin if y>x then m←m+1 end;
02300	
02400	if m=p then go to a;
02500	if ((m<p) and (dc<0)) or ((m>p) and (dc>0)) then dc←-0.5*dc;
02600	go to b;
02700	
02800	a:
02900	outstr("c ="&cvf(c)&" dc ="&cvf(dc)&" m ="&cvs(m)
03000	&" y ="&cvf(y));
03100	
03200	y←0;w←p;
03300	for i←1 step 1 until q do
03400	begin j←z←c+sqrt(y);y←z-j;if 0<y<w then w←y end;
03500	dx←.01*w;
03600	
03700	dc0←dc←abs(dc);
03800	bb:
03900	for x←0.0 step dx until w+w do begin
04000	y←x;m←0;
04100	for i←1 step 1 until q do begin
04200	m←m+(j←z←c+sqrt(y));y←z-j end;
04300	if m > 0 then begin if y<x then m←m-1 end
04400	else if m<0 then begin if y>x then m←m+1 end;
04500	
04600	if m=p then begin c←c-dc;xmin←x; go to bb end end;
04700	if dc>0.1@-6 then begin dc←0.5*dc;c←c+dc;go to bb end;
04800	
04900	cmin←c←c+dc; dc←dc0;
05000	cc:
05100	for x←0.0 step dx until w do begin
05200	y←x;m←0;
05300	for i←1 step 1 until q do begin
05400	m←m+(j←z←c+sqrt(y));y←z-j end;
05500	if m > 0 then begin if y<x then m←m-1 end
05600	else if m<0 then begin if y>x then m←m+1 end;
05700	
05800	if m=p-1 then begin c←c+dc;xmax←x; go to cc end end;
05900	if dc>0.1@-6 then begin dc←0.5*dc;c←c-dc;go to cc end;
06000	cmax←c←c-dc;
06100	
06200	outstr("
06300	cmin ="&cvf(cmin)&" cmax ="&cvf(cmax)&" range ="
06400	&cvf(cmax-cmin)&"
06500	xmin ="&cvf(xmin)&" xmax ="&cvf(xmax)&" w ="&cvf(w));
06600	go to aa end;